home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dump_s1r / buttonmg.cls < prev    next >
Encoding:
Visual Basic class definition  |  1998-12-20  |  4.3 KB  |  137 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ButtonMngr"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  11. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  12. Option Explicit
  13. Public Event ButtonClick(Button As ComboPack.Button)
  14. Public Event ButtonPress(Button As ComboPack.Button)
  15. Public Event ButtonRelease(Button As ComboPack.Button)
  16. Public Event ButtonGetFocus(Button As ComboPack.Button)
  17. Public Event ButtonLostFocus(Button As ComboPack.Button)
  18. Private m_ButtonColl As Collection
  19. Public LastFocus As Integer
  20. Private Sub Class_Initialize()
  21. LastFocus = 1
  22.     Set m_ButtonColl = New Collection
  23. End Sub
  24.  
  25. Private Sub Class_Terminate()
  26.     Set m_ButtonColl = Nothing
  27. End Sub
  28.  
  29. Public Function AddButton(ButtonName As String, Caption As String, Left As Single, Top As Single, Width As Single, Height As Single, BackColor As OLE_COLOR, Container As Object, Optional Picture As StdPicture)
  30.     Dim nclsBtn As ComboPack.Button
  31.     Set nclsBtn = New ComboPack.Button
  32.     nclsBtn.Enabled = True
  33.     Set nclsBtn.Parent = Container
  34.     Set nclsBtn.ButtonParentObj = Me
  35.     nclsBtn.Name = ButtonName
  36.     nclsBtn.Left = Left
  37.     nclsBtn.Top = Top
  38.     nclsBtn.Width = Width
  39.     nclsBtn.Height = Height
  40.     Set nclsBtn.Picture = Picture
  41.     nclsBtn.BackColor = BackColor
  42.     nclsBtn.Caption = Caption
  43.     m_ButtonColl.Add nclsBtn
  44.     Set AddButton = nclsBtn
  45.     Set nclsBtn = Nothing
  46. End Function
  47.  
  48. Public Sub MouseUp(Button As Integer, X As Single, Y As Single)
  49.     Dim cBtn As ComboPack.Button, m_lngLoop As Long
  50.     For m_lngLoop = 1 To m_ButtonColl.Count
  51.         Set cBtn = m_ButtonColl(m_lngLoop)
  52.         cBtn.MouseUp Button, X, Y
  53.     Next
  54. End Sub
  55.  
  56. Public Sub MouseDown(Button As Integer, X As Single, Y As Single)
  57.     Dim cBtn As ComboPack.Button, m_lngLoop As Long
  58.     For m_lngLoop = 1 To m_ButtonColl.Count
  59.         Set cBtn = m_ButtonColl(m_lngLoop)
  60.         cBtn.MouseDown Button, X, Y
  61.     Next
  62. End Sub
  63.  
  64. Public Sub MouseMove(Button As Integer, X As Single, Y As Single)
  65.     Dim cBtn As ComboPack.Button, m_lngLoop As Long
  66.     For m_lngLoop = 1 To m_ButtonColl.Count
  67.         Set cBtn = m_ButtonColl(m_lngLoop)
  68.         cBtn.MouseMove Button, X, Y
  69.     Next
  70. End Sub
  71.  
  72. Public Sub RaiseBtnEvent(Button As ComboPack.Button, EventType As Integer)
  73.     Dim jbutton As ComboPack.Button, Index As Long
  74.     Select Case EventType
  75.         Case const_lngPress
  76.             For Each jbutton In m_ButtonColl
  77.                 Index = Index + 1
  78.                 If jbutton.Name = Button.Name Then
  79.                     LastFocus = Index
  80.                 End If
  81.                 If jbutton.HasFocus Then jbutton.HasFocus = False
  82.             Next
  83.             If Not Button.HasFocus Then Button.HasFocus = True
  84.             RaiseEvent ButtonPress(Button)
  85.         Case const_lngUnPress
  86.             RaiseEvent ButtonRelease(Button)
  87.         Case const_lngClick
  88.             RaiseEvent ButtonClick(Button)
  89.         Case const_lngGotFocus
  90.             RaiseEvent ButtonGetFocus(Button)
  91.         Case const_lngLostFocus
  92.             RaiseEvent ButtonLostFocus(Button)
  93.     End Select
  94. End Sub
  95.  
  96. Public Property Get Buttons(Index As Long) As ComboPack.Button
  97. On Error Resume Next
  98. Set Buttons = m_ButtonColl(Index)
  99. End Property
  100.  
  101. Public Property Get NewEnum() As IUnknown
  102. Attribute NewEnum.VB_UserMemId = -4
  103. Attribute NewEnum.VB_MemberFlags = "40"
  104.     Set NewEnum = m_ButtonColl.[_NewEnum]
  105. End Property
  106.  
  107.  
  108. Public Sub KeyDown(KeyCode As Integer)
  109.     If LastFocus = 0 Then _
  110.         Exit Sub
  111.     If KeyCode = vbKeyTab Then
  112.     If Not Buttons(CLng(LastFocus)).HasFocus Then _
  113.         Buttons(CLng(LastFocus)).HasFocus = True _
  114.         : Exit Sub
  115.     Buttons(CLng(LastFocus)).HasFocus = False
  116.     If LastFocus = m_ButtonColl.Count Then _
  117.         LastFocus = 0
  118.     If Buttons(CLng(LastFocus + 1)).Enabled Then
  119.         On Error Resume Next
  120.         On Error GoTo 0
  121.         LastFocus = LastFocus + 1
  122.         Buttons(CLng(LastFocus)).HasFocus = True
  123.     Else
  124.         LastFocus = LastFocus + 1
  125.         KeyDown (KeyCode)
  126.     End If
  127.     End If
  128. End Sub
  129.  
  130. Public Property Get Count() As Long
  131. Count = m_ButtonColl.Count
  132. End Property
  133.  
  134. Public Sub Remove(Index As Long)
  135. m_ButtonColl.Remove Index
  136. End Sub
  137.